home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr01 / jock.zip / TOTDEM11.ZIP / TBROWSE.PAS < prev    next >
Pascal/Delphi Source File  |  1991-02-11  |  6KB  |  228 lines

  1. program tot_Browse;
  2.  
  3.   { This demo program written using substantial portions of the   }
  4.   { Technojock Object Toolkit in order to demonstrate how various }
  5.   { objects and their methods can be integrated.                  }
  6.   {                                                               }
  7.   { Copyright 1991 by George L. Butts  Small Systems Development  }
  8.   {                                    Springfield, Oregon        }
  9.   { This and other programs utilizing TOT can be found on         }
  10.   { The Buffer Board, a public BBS specializing in support of     }
  11.   { programmers at (503) 747-7636  300-14400 Baud  24 hours       }
  12.  
  13.   uses
  14.     Dos, Crt, totLink, totList, totInput, totDir, totIO1, totFast,
  15.     totMsg, Printer, totMisc, totDate, totStr, totWin, totLook;
  16.  
  17.   var
  18.     MyScreen    : WinObj;
  19.     OldX        : Byte;
  20.     OldY        : Byte;
  21.     FileList    : StrDLLObj;
  22.     LineNo      : Word;
  23.     PageNo      : Word;
  24.     WinActive   : Boolean;
  25.     InFile      : Text;
  26.     Line        : String;
  27.     RetCode     : Integer;
  28.     I           : Integer;
  29.     FName       : String;
  30.     BrowseList  : BrowseLinkObj;
  31.     DirWin      : DirWinObj;
  32.     Result      : tAction;
  33.  
  34. {$F+}
  35.   procedure Error_Message( Line : String );
  36.     Var
  37.       MsgWin  : ButtonMessageObj;
  38.     begin
  39.       With MsgWin do
  40.         begin
  41.           Init(1,' Error ' );
  42.           AddLine('');
  43.           AddLine( Line );
  44.           AddLine('');
  45.           Show;
  46.           Done;
  47.         end;
  48.     end;
  49.  
  50.   Procedure LoadFile( FName : String; Var LList : StrDLLObj );
  51.     begin
  52.       Assign( InFile , FName );
  53.       Reset( InFile );
  54.       With LList do
  55.         begin
  56.           Init;
  57.           RetCode := 0;
  58.           While (NOT EOF(InFile)) AND (RetCode = 0) do
  59.             begin
  60.               ReadLn(InFile,Line);
  61.               RetCode := Add(Line);
  62.             end;
  63.         end;
  64.       If RetCode = 2
  65.         then
  66.           Error_Message( 'Unable to Load Entire File' );
  67.       Close(InFile);
  68.     end;
  69.  
  70.   Procedure SelectFile( Var FName : String; Var Result : tAction );
  71.     begin
  72.       DirWin.Init;
  73.       DirWin.Win^.SetColors(112,112,113,112);   { Set the Directory window colors}
  74.       DirWin.SetFileDetails('','*.pas',Archive);
  75.       With IOTot^ do
  76.         begin
  77.           SetColLabel(120,113,112,113);
  78.           SetColList(63,23,31,127);
  79.           SetColField(23,31,23,23);
  80.           SetColButton(23,26,31,26);
  81.           SetColMsg(116);
  82.         end;
  83.       Result := DirWin.Go;
  84.       If Result = Finished
  85.         then
  86.           FName := DirWin.GetChosenFile
  87.         else
  88.           FName := '';
  89.       DirWin.Done;
  90.     end;
  91.  
  92.   Procedure Display_Date_Time;
  93.     begin
  94.       with Screen do
  95.       begin
  96.          SetWinIgnore(true);
  97.          WriteAt(2,25,112,FancyDateStr(TodayInJul,False,False));
  98.          WriteRight(79,25,112,CurrentTime);
  99.          SetWinIgnore(false);
  100.       end;
  101.     end;
  102.  
  103.   Procedure Display_Interface;
  104.     begin
  105.       With MyScreen do
  106.         begin
  107.           LookTot^.SetWindow(112,112,113,113);
  108.           Init;
  109.           SetSize(1,1,80,25,0);
  110.           Setcolors(23,23,23,23);
  111.           SetClose(False);
  112.           SetRemove(True);
  113.           Draw;
  114.           With Screen do
  115.             begin
  116.               CursOff;
  117.               Box(1,2,80,24,23,1);
  118.               Attrib(1,1,80,1,112);
  119.               Attrib(1,25,80,25,112);
  120.               WriteBetween(1,80,1,112,'t o t B r o w s e');
  121.             end;
  122.         end;
  123.     end;
  124.  
  125.  
  126.   Procedure NewPage;
  127.     begin
  128.       Inc(PageNo);
  129.       WriteLn(Lst);
  130.       WriteLn(Lst,PadLeft(SetProper(FileName(FName)) + '.' +
  131.                   SetProper(FileExt(FName)),20,' ') +
  132.                   PadCenter(FancyDateStr(TodayInJul,True,False),35,' ') +
  133.                   PadRight(CurrentTime,20,' ') );
  134.       WriteLn(Lst,Replicate(75,'_'));
  135.       WriteLn(Lst);
  136.       LineNo := 4;
  137.     end;
  138.  
  139.   Procedure FinishPage;
  140.     begin
  141.       WriteLn(Lst,Replicate(75,'_'));
  142.       WriteLn(Lst,'Small Systems Development' + Replicate(42,' ') + 'Page: '
  143.                    + PadRight(IntToStr(PageNo),2,' ') );
  144.       WriteLn(Lst,Chr(12));
  145.     end;
  146.  
  147.   Procedure Print_Line( Line : String );
  148.     begin
  149.       Inc(LineNo);
  150.       If LineNo = 62
  151.         then
  152.           begin
  153.             FinishPage;
  154.             NewPage;
  155.           end;
  156.       WriteLn(Lst, Squeeze('R',Line,76) );
  157.     end;
  158.  
  159.   Procedure Print_File_Listing;
  160.     Var
  161.       I  : Word;
  162.     begin
  163.       NewPage;
  164.       With FileList do
  165.         begin
  166.           For I := 1 to TotalNodes do
  167.             Print_Line( GetStr(NodePtr(I),0,0) );
  168.         end;
  169.       For I := LineNo to 61 do
  170.         WriteLn(Lst);
  171.       FinishPage;
  172.     end;
  173.  
  174.   Procedure KeyPressedProcedure( Var KeyVal : Word );
  175.     begin
  176.       Case KeyVal of
  177.         317 : begin     {  F3 - Load a different File }
  178.                 SelectFile( FName , Result );
  179.                 If Result = Finished
  180.                   then
  181.                     begin
  182.                       LoadFile( FName , FileList );
  183.                       BrowseList.AssignList(FileList);
  184.                       BrowseList.SetTopPick(2);
  185.                       KeyVal := 329;
  186.                     end;
  187.               end;
  188.         321 : begin     {  F7 - Print File            }
  189.                 Print_File_Listing;
  190.               end;
  191.       end;
  192.     end;
  193. {$F-}
  194.  
  195.  
  196.   begin
  197.     OldX := WhereX;
  198.     OldY := WhereY;
  199.     PageNo := 0;
  200.     LineNo := 0;
  201.     Key.AssignIdleHook( Display_Date_Time );
  202.     Key.setFast;
  203.     Shadowtot^.SetShadowSize(0,0);
  204.     Display_Interface;
  205.     SelectFile( FNAme , Result );
  206.     If FName <> ''
  207.       then
  208.         begin
  209.           LoadFile( FName , FileList );
  210.           Key.AssignPressedHook( KeypressedProcedure );
  211.           With BrowseList do
  212.             begin
  213.               Init;
  214.               Win^.SetAllowStretch(False);
  215.               Win^.SetBoundary(1,2,80,24);
  216.               Win^.SetSize(1,2,80,24,1);
  217.               Win^.SetMinSize(80,23);
  218.               Win^.SetColors(31,31,31,18);
  219.               AssignList( FileList );
  220.               Go;
  221.               Done;
  222.             end;
  223.           FileList.Done;
  224.         end;
  225.     MyScreen.Done;
  226.     ResetStartUpMode;
  227.   end.
  228.